#|___________________________________________________________________
 |
 | ViSta Plots, Views  and Corkboards System
 | Copyright 2001-2002 by Forrest W. Young
 |
 |______________________________________________________________________________
 |
 | sketch01.lsp
 |
 | Contains a skeleton of the code for the ViSta ETCH-A-SKETCH OBJECT
 |
 |     The ETCH-A-SKETCH object is a GUI for creating new spreadplots
 |     The code in file sketch01.lsp loads this part of the code.
 |
 |     This code does not work, other than putting up a Etch-a-Sketch window.
 |     The code is only a skeleton of the concept. Much work needs to be done.
 |
 |______________________________________________________________________________
 |
 |
 | Using the Etch-a-sketch OBJECT:
 |
 | Etch-a-Sketch is a container window with menuing system and methods to enable users
 | to visually design spreadplots, including their layout and messageing
 |
 | The Etch-a-Sketch constructor function has the following syntax and arguments:
 |
 | (Etch-a-Sketch  &key arguments)
 |
 | Unique Etch-a-Sketch argument:
 | (reuse t)     New graphics go into this (T) or into a new (NIL) Etch-a-Sketch.
 |               When reused, new graphics will have previous size and location 
 |               unless those values are specified.
 |
 | Standard container window arguments:
 | (in nil in-used?) (toolwindow nil) (localmenu t) (style 5)
 |
 | Standard window arguments:
 | (frame-size nil) (frame-location nil) (size nil) (location nil) 
 | (title "GraphFrame") (show t) (menu nil) (black-on-white t) 
 | (has-v-scroll nil) (has-h-scroll nil)) 
 |____________________________________________________________________________ 
 |#



(defun  Etch-a-Sketch 
  (&key (in nil in-used?) (toolwindow nil) (pallet nil) (localmenu t) (enabled t) (style 5) 
        (frame-size nil) (frame-location nil) (size nil) (location nil) 
        (title "SpreadPlot Maker") (show t) (reuse t)
        (menu nil) (black-on-white t) (has-v-scroll nil) (has-h-scroll nil))
"ARGS: Same as for vista-container, except
SIZE defaults to .5 of effective-screen-size
LOCATION defaults to lower-right-corner
REUSE is T by default. When reused, unless SHOW is NIL, will appear in previous size and location unless those values are specified."

  (when (or (not (boundp '*corkboard*))     
            (not *corkboard*)
            (not reuse))
        (if pallet (setf toolwindow t))
        (let* ((frame-size (if frame-size frame-size
                               (unless size (round (* .5 (effective-screen-size))))))
               (frame-location (if frame-location frame-location 
                                   (unless location (- (effective-screen-size) 
                                                       (if size size frame-size))))))
          (setf *corkboard* 
                (send vista-corkboard-proto :new style :in in :in-used? in-used?
                      :localmenu localmenu :toolwindow toolwindow 
                      :frame-size frame-size :frame-location frame-location
                      :size size :location location  :title title :show show
                      :menu menu :black-on-white black-on-white
                      :has-v-scroll has-v-scroll :has-h-scroll has-h-scroll))))
  (enable-container *corkboard*)
  (send *corkboard* :n-graphs (1+ (send *corkboard* :n-graphs)))
  (when show
        (send *corkboard* :show-window)
        (send *corkboard* :front-window))
  (if (or frame-size size) 
      (if frame-size 
          (apply #'send *corkboard* :frame-size frame-size)
          (apply #'send *corkboard* :size size)))
  (if (or frame-location location) 
      (if frame-location
          (apply #'send *corkboard* :frame-location frame-location)
          (apply #'send *corkboard* :location location)))
  *corkboard*)

(defun new-spreadplot-maker (&rest args)
  (setf *corkboard* nil)
  (apply #'corkboard args))

(defun show-spreadplot-maker ()
  (when *corkboard* (send *corkboard* :front-window)))

(defun corkboard-window (&rest args) (apply #'corkboard args))

(defun graph-frame (&rest args) (apply #'corkboard args))

(setf *corkboard* nil)

(setf *desktop-window-corkboard-item*
      (send menu-item-proto :new "SpreadPlot Maker"
              :action 'corkboard-window))

(let* ((items (send *desktop-window-menu* :items))
       )
  (apply #'send *desktop-window-menu* :delete-items 
         (send *desktop-window-menu* :items))
  (apply #'send *desktop-window-menu* :append-items
        (first items)
        (second items)
        *desktop-window-corkboard-item*
        (select items (iseq 2 (1- (length items)))))
  )


(defproto vista-corkboard-proto '() () vista-container-proto)

(defmeth vista-corkboard-proto :isnew (&rest args )
  (apply #'call-next-method args)
  (send self :make-menus))

(defmeth vista-corkboard-proto :after-new-plot (pop-out top-most show plot size actcon)
  (send self :graphs (append (send self :graphs) (list plot)))
  (send plot :after-new-plot pop-out top-most show size actcon)
  (if actcon 
      (enable-container actcon)
      (disable-container))
  plot)

(defmeth vista-corkboard-proto :close ()
  (setf *corkboard* nil)
  (call-next-method))
  



(defmeth vista-corkboard-proto :seen-in (in in?)
"Args IN IN?
Determines where windows will be seen and returns value indicating where this is. IN can be T, NIL, or a container window object. IN? can be T or NIL. Will be seen on the Desktop if IN? is NIL or if none of the following conditions hold: Will be seen in IN if IN is a container object; in *ACTIVE-CONTAINER* if IN is T and there is an active container; or in the XLISPSTAT window if IN is NIL. Returns T, NIL or IN, meaning the window will appear on the DESKTOP, in XLISPSTAT or in CONTAINER, respectively."
  (cond 
    ((not in?)    (enable-container self)   t)   ;desktop
    ((not in)     (disable-container)      nil)  ;xlispstat
    ((objectp in) (enable-container in)     in)  ;IN
    ((and (equal t in) 
          (objectp *active-container*))    *active-container*) ;*active-container*
    (t            (enable-container self)   t)   ;desktop
    ))

(defmeth vista-corkboard-proto :make-menus ()
  (send self :make-corkboard-window-menu)
  (send self :make-corkboard-file-menu)
  (send self :make-corkboard-edit-menu)
  (send self :make-corkboard-graphics-menu)
  (send self :make-corkboard-actions-menu)
  )

(defmeth vista-corkboard-proto :make-corkboard-file-menu ()
    (setf *graphics-window-file-menu* (send menu-proto :new "File"))
    (send *graphics-window-file-menu* :install)
    (send *graphics-window-file-menu* :append-items
          (setf *open-spreadplot-menu-item*
                (send expert-menu-item-proto :new "Open SpreadPlot File" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* 
                                                 :open-spreadplot )))) 
          (send dash-item-proto :new)
          (setf *save-spreadplot-menu-item*
                (send expert-menu-item-proto :new "Save SpreadPlot File" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* 
                                                 :save-spreadplot )))) 
          )
    )


(defmeth vista-corkboard-proto :make-corkboard-edit-menu ()
    (setf *graphics-window-tool-menu* (send menu-proto :new "Edit"))
    (send *graphics-window-tool-menu* :install)
    (send *graphics-window-tool-menu* :append-items
          (setf *new-row-menu-item*
                (send expert-menu-item-proto :new "New Row" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* :new-row))))
          (setf *same-cell-menu-item*
                (send expert-menu-item-proto :new "Same Cell" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* :same-cell))))
          (setf *delete-plot-menu-item*
                (send expert-menu-item-proto :new "Delete Plot" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* :same-cell))))
          (send dash-item-proto :new)
          (setf *make-spreadplot-menu-item*
                (send expert-menu-item-proto :new "Make SpreadPlot" :enabled t
                      :action #'(lambda () (make-spreadplot))))
          (setf *modify-spreadplot-arguments-menu-item*
                (send expert-menu-item-proto :new "Modify SpreadPlot Arguments" 
                                             :enabled  t
                      :action #'(lambda () 
                                  (send *graphics-sketchpad-window*
                                        :modify-spreadplot-arguments))))   
          (send dash-item-proto :new)
          (setf *new-action-symbol-menu-item*
                (send expert-menu-item-proto :new "New Action Symbol" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* 
                                                 :new-action-symbol))))  
    
          (setf *edit-action-code-menu-item*
                (send expert-menu-item-proto :new "Edit Action Code" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* 
                                                 :edit-action-code))))
          
          (setf *select-action-menu-item*
                (send expert-menu-item-proto :new "Select Action" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* 
                                                 :select-action))) )
          (send dash-item-proto :new)
          (setf *save-spreadplot-menu-item*
                (send expert-menu-item-proto :new "Save SpreadPlot" :enabled t
                      :action #'(lambda () (send *graphics-sketchpad-window* 
                                                 :save-spreadplot )))) 
    ))



(defmeth vista-corkboard-proto :make-corkboard-graphics-menu ()
    (setf *graphics-window-graphics-menu* (send menu-proto :new "Plots"))
    (send *graphics-window-graphics-menu* :install)
    (send *graphics-window-graphics-menu* :append-items
          (send expert-menu-item-proto :new "Null Plot" :enabled t
                :action #'(lambda () (null-plot $ :in self)))
          (send dash-item-proto :new)
          (send expert-menu-item-proto :new "Text Window" :enabled t
                :action #'(lambda () (text-window $  :in self)))
          (send expert-menu-item-proto :new "DataSheet" :enabled t
                :action #'(lambda () (datasheet $  :in self)))
          (send dash-item-proto :new)
          (send expert-menu-item-proto :new "Variable List" :enabled t
                :action #'(lambda () (var-list $  :in self)))
          (send expert-menu-item-proto :new "Observation List" :enabled t
                :action #'(lambda () (obs-list $  :in self)))
          (send dash-item-proto :new)
          (send expert-menu-item-proto :new "Frequency Plot"         ;NEW DEF
              :enabled t
              :action  #'(lambda () (frequency-plot)))
        (send expert-menu-item-proto :new "Histogram Plot" :enabled t           ;NEW DEF
                :action  #'(lambda () (histogram-plot)))
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Normal Probability Plot" :enabled t  ;REDEF
              :action  #'(lambda () (normal-probability-plot )))
        (send expert-menu-item-proto :new "Quantile Plot" :enabled t            ;REDEF
              :action  #'(lambda () (quantile-plot)))
          (send expert-menu-item-proto :new "Quantile-Quantile Plot" :enabled t ;REDEF
                :action  #'(lambda () (quantile-quantile-plot)))
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Scatter Plot" :enabled t             ;NEW DEF
              :action #'(lambda () (scatter-plot))) 
        (send expert-menu-item-proto :new "Scatter Plot Matrix" :enabled t
              :action #'(lambda () (scatter-plot-matrix)))    
        (send expert-menu-item-proto :new "3D Spinning Plot" :enabled t         ;NEW DEF
              :action #'(lambda () (3d-spinning-plot)))
        (send expert-menu-item-proto :new "HD Spinning Plot" :enabled t
                :action #'(lambda () (hd-spinning-plot)))                       ;NEW DEF
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Dot Plot" :enabled t                 ;NEW DEF
              :action #'(lambda () (dot-plot)))
        (send expert-menu-item-proto :new "Box Plot" :enabled t                 ;NEW DEF
              :action #'(lambda () (box-plot)))
       ; (send expert-menu-item-proto :new "Diamond Plot" :enabled t            ;NEW DEF
       ;       :action #'(lambda () (diamond-plot)))
        (send expert-menu-item-proto :new "Grouped Box Plot" :enabled t
              :action  #'(lambda () (grouped-box-plot)))
        (send expert-menu-item-proto :new "Parallel Coordinates Plot" :enabled t
                :action  #'(lambda () (parallel-coordinates-plot)))  
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Bar Graph" :enabled t                ;REDEF
              :action  #'(lambda () (bar-graph)))
        (send expert-menu-item-proto :new "Mosaic Plot" :enabled t              ;REDEF
              :action  #'(lambda () (mosaic-plot)))
          ))

(defmeth vista-corkboard-proto :make-corkboard-actions-menu ()
  (setf *graphics-window-actions-menu* (send menu-proto :new "Actions"))
  (send *graphics-window-actions-menu* :install)
  )

(defmeth vista-corkboard-proto :make-corkboard-window-menu ()
  (setf *corkboard-window-menu* (send menu-proto :new "Window"))
  (send *corkboard-window-menu* :install)
  (send *corkboard-window-menu* :append-items
        (send menu-item-proto :new "Graph Window Frame Help" 
              :action #'(lambda () (graph-window-frame-help)))
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "DeskTop Window"
              :action #'(lambda () (desktop-window)))
        (send expert-menu-item-proto :new "XLispStat Window"
                :action #'(lambda () (xlispstat-window)))
        (send expert-menu-item-proto :new "ViVa Window"
            :action #'(lambda () (viva-window)))
	;(send expert-menu-item-proto :new "GraphFrame Window"
        ;    :action #'(lambda () (GraphFrame-window)))
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Current DataSheet Window" 
              :action #'(lambda () (current-datasheet)))
        (send expert-menu-item-proto :new "Current Report Window" 
              :action 'current-report)
	(send expert-menu-item-proto :new "Current SpreadPlot Window"
            :action #'(lambda () (spreadplot-window)))
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Copy Graph Window Frame"
              :action 'copy-graph-window-frame)
        (send expert-menu-item-proto :new "Print Graph Window Frame"
              :action 'print-graph-window-frame)
        (send expert-menu-item-proto :new "Refresh Graph Window Frame"
              :action 'refresh-graph-window-frame)))




(defmeth vista-corkboard-proto :make-spreadplot-container-resize (spreadplot)
    (send spreadplot :make-spreadplot-container-resize self))


(defmeth spreadplot-proto :make-spreadplot-container-resize (container)
  (let ((spreadplot self))
    (send container :idle-on nil)
    (defmeth container :resize ()
      (send container :resize-it))
    (defmeth container :resize-it ()
      (cond
        ((send container :idle-on) )
        (t 
         (mapcar #'(lambda (plot) 
                     (defmeth plot :redraw ()))
                 (send spreadplot :all-plots))
         (send container :idle-on t))))
    (defmeth container :do-idle ()
      (send container :idle-on nil)
      (mapcar #'(lambda (plot) 
                  (defmeth plot :redraw ()
                    (call-next-method)))
              (send spreadplot :all-plots))
      (send spreadplot :resize-it))
    (defmeth spreadplot :resize-it ()
      (send spreadplot :screen-size (send container :size))
      (send spreadplot :create-spreadplot)
      (defmeth container :resize ())
      (send container :fix-splot-size (send container :size))
      (send spreadplot :resize)
      (apply #'send container :size (+ '(4 22) (send spreadplot :size)));0 20
      (send spreadplot :size (send container :size))
      (defmeth container :resize ()
        (send self :resize-it))
      )
    ))



(defmeth vista-corkboard-proto :modify-spreadplot-arguments ()
"Args:
Gets layout options. The options are SHAPE, PERMUTATION, NROWS, NCOLS, SPAN-RIGHT, SPAN-DOWN, RELATIVE-WIDTHS and RELATIVE-HEIGHTS."
  (let* ((container self)
         (title-text-item (send text-item-proto :new "THE SPREADPLOT GRID HAS:"))
         (nrows (send self :num-rows))
         (nrows-item (send edit-text-item-proto :new (format nil "~a" nrows)))
         (nrow-text-item (send text-item-proto :new "ROWS:"))
         (ncols (send self :num-cols))
         (ncols-item (send edit-text-item-proto :new (format nil "~a" ncols)))
         (ncol-text-item (send text-item-proto :new "COLUMNS:"))
         (plots-text-item (send text-item-proto :new "Selectable Plots"))
         (cells-text-item (send text-item-proto :new "Selected Plots"))
         (plots-list (send container :plot-cells))
         (plots-list (mapcar #'(lambda (plot) (send plot :title)) plots-list))
         (cells-list (repeat " " (length plots-list)))
         (plots-list-item (send list-item-proto :new plots-list
                                :action #'(lambda () (move-plots &optional dc))))
         (cells-list-item (send list-item-proto :new cells-list
                                :action #'(lambda () (move-cells &optional dc))))
         (right-span-default (repeat 1 (* nrows ncols)))
         (down-span-default (repeat 1 (* nrows ncols)))
         (rel-width-default (repeat 1 ncols))
         (rel-height-default (repeat 1 nrows))
         (right-span-item (send text-item-proto :new "Span-Rights"))
         (down-span-item (send text-item-proto :new "Span-Downs"))
         (right-spans 
          (send edit-text-item-proto :new 
                (if (send self :span-right) 
                    (strcat "     " (format nil "~a" (send self :span-right) "     "))
                    (strcat "     " (format nil "~a" down-span-default) "     "))))
         (down-spans  
          (send edit-text-item-proto :new 
                (if (send self :span-down)
                    (strcat "     " (format nil "~a" (send self :span-right) "     "))
                    (strcat (APPLY #'strcat "   " (repeat (repeat "  1" ncols) (1+ nrows))) "     "))))
         (rel-width-item  (send text-item-proto :new "Relative Column Widths"))
         (rel-height-item (send text-item-proto :new "Relative Row Heights"))
         (rel-widths (send edit-text-item-proto :new 
                           (if (send self :rel-widths) 
                               (format nil "~a" (send self :rel-widths))
                               (format nil "~a" rel-width-default))))
         (rel-heights (send edit-text-item-proto :new 
                            (if (send self :rel-heights) 
                                (format nil "~a" (send self :rel-heights))
                                (format nil "~a" rel-height-default))))
         (ok        (send modal-button-proto :new "OK"
                          :action #'(lambda () 
                                      (list
                                       (read (make-string-input-stream
                                              (send nrows-item :text)) nil)
                                       (read (make-string-input-stream
                                              (send ncols-item :text)) nil)
                                       (send cells-list-item :item-list)
                                       (combine 
                                        (read (make-string-input-stream 
                                               (send right-spans :text)) nil))
                                       (combine 
                                        (read (make-string-input-stream 
                                               (send down-spans :text)) nil))
                                       (combine 
                                        (read (make-string-input-stream 
                                               (send rel-widths :text)) nil))
                                       (combine 
                                        (read (make-string-input-stream 
                                               (send rel-heights :text)) nil))
                                       ))))
         (cancel    (send modal-button-proto :new "Cancel"))
         (help      (send modal-button-proto :new "Help"))
         (dialog    (send modal-dialog-proto :new
                           (list title-text-item
                                 (list (list
                                        (list ncols-item ncol-text-item)
                                        (list nrows-item nrow-text-item)
                                        )
                                       help)
                                 (list (list plots-text-item plots-list-item)
                                       (list cells-text-item cells-list-item))
                                 (list (list right-span-item right-spans
                                             down-span-item down-spans)
                                       (list rel-width-item rel-widths
                                             rel-height-item rel-heights))
                                 (list ok cancel))
                          :default-button ok)))
    (setf result (send dialog :modal-dialog))
    (send self :num-rows (first result))
    (send self :num-cols (second result))
    (send self :span-right (fourth result))
    (send self :span-down (fifth result))
    (send self :rel-widths (sixth result))
    (send self :rel-heights (seventh result))
    (send self :make-spreadplot)
    result
    ))



#|
 |MAKE SPREADPLOT from graphs inside the *graphics-window* container
 |#

(defmeth vista-corkboard-proto :make-spreadplot ()
  (setf *spreadplot-container* *graphics-sketchpad-window* )
  (let* ((container *spreadplot-container*)
         (graph-list (send *graphics-sketchpad-window* :plot-cells))
         (num-graphs (length graph-list))
         (size (floor (/ (effective-screen-size) 2)))
         (nrows (send container :num-rows))
         (ncols (send container :num-cols))
         (rows-cols (if (or (not nrows) (not ncols))
                        (case num-graphs
                          (0 (error "; there are no graphs.~%"))
                          (1 (error "; there must be more than 1 graph.%"))
                          (2 (list 1 2))
                          (3 (list 1 3))
                          (4 (list 2 2))
                          (5 (list 2 3))
                          (6 (list 2 3))
                          (t (format t "; Automatic shaping only for 2-6 graphs.~%")))
                        (list nrows ncols)))
         (nrows (if nrows nrows (first rows-cols)))
         (ncols (if ncols ncols (second rows-cols)))
         (num-cells (* nrows ncols))
         (rel-heights (send container :rel-heights))
         (rel-widths (send container :rel-widths))
         (span-down (send container :span-down))
         (span-right (send container :span-right))
         (span-down (if span-down span-down (repeat 1 num-cells)))
         (span-right (if span-right span-right (repeat 1 num-cells)))
         (splot nil)
         )
    (send container :num-rows nrows)
    (send container :num-cols ncols)
    (when (= num-graphs 5)
          (setf span-down '(1 1 2 1 1 0))
          (setf graph-list (append graph-list (list nil))))
    (setf splot (spreadplot (matrix rows-cols graph-list)
                            :span-down (matrix rows-cols span-down)
                            :span-right (matrix rows-cols span-right)
                            :rel-heights rel-heights
                            :rel-widths rel-widths
                            :container *graphics-sketchpad-window* :size size))
    (setf *graphics-frame* splot)
    (send *graphics-sketchpad-window* :spreadplot splot)
    (send splot :show-window)
    (send splot :calculate-splot-size )
    ; (apply #'send *graphics-sketchpad-window* :size (send splot :size))
    (send splot
          :make-spreadplot-container-resize *graphics-sketchpad-window* )
    (send *graphics-sketchpad-window* :resize)
    *graphics-sketchpad-window*))


(defmeth vista-corkboard-proto :pop-out-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be popped out."
  (unless (send self :has-slot 'pop-out-on)
          (send self :add-slot 'pop-out-on))
  (if set (setf (slot-value 'pop-out-on) logical))
  (slot-value 'pop-out-on)) 


(defmeth vista-corkboard-proto :top-most-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be made to be top most."
  (unless (send self :has-slot 'top-most-on)
          (send self :add-slot 'top-most-on))
  (if set (setf (slot-value 'top-most-on) logical))
  (slot-value 'top-most-on)) 


(defmeth graph-proto :pop-out-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be popped out."
  (unless (send self :has-slot 'pop-out-on)
          (send self :add-slot 'pop-out-on))
  (if set (setf (slot-value 'pop-out-on) logical))
  (slot-value 'pop-out-on)) 


(defmeth graph-proto :top-most-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be made to be top most."
  (unless (send self :has-slot 'top-most-on)
          (send self :add-slot 'top-most-on))
  (if set (setf (slot-value 'top-most-on) logical))
  (slot-value 'top-most-on)) 


(defmeth graph-proto :container (&optional (objid nil set))
"Message args: (&optional logical)
 Sets or retrieves object id of a graph's container, if there is one."
  (unless (send self :has-slot 'container)
          (send self :add-slot 'container))
  (if set (setf (slot-value 'container) objid))
  (slot-value 'container)) 

